Cream of the Crop 20/Cream of the Crop 20 (Terry Blount) (1996).iso/program/commio0b.zip/MTASK.PAS

Pascal/Delphi Source File | 1996-05-06 | 13KB | 510 lines

UNIT mtask;

{MTASK 2.0, a simple multi-tasker unit for Turbo Pascal 5.

Written in November, 1988, and donated to the public domain by:

   Wayne E. Conrad
   2627 North 51st Ave, #219
   Phoenix, AZ  85035
   BBS: [phone], 300/1200/2400, 24 hours/day

This unit provides Turbo Pascal 5 with what I call "request driven"
multi-tasking.  Switching from the current task to another task is done
whenever the current task requests a task switch by calling procedure
"switch_task."  No interrupt driven context switching is done, because
it's a hassle.}


{$F+}  {Most procedures in this unit must be FAR}


INTERFACE


{Result codes.  0 is "no error"}

CONST
  heap_full       = 1;   {Unable to allocate heap for the task's stack}
  too_many_tasks  = 2;   {Maximum number of tasks are already running}
  invalid_task_id = 3;   {There is no task with that ID number}


{This is the procedure type for a task.  The parent task can pass any
type of variable to  the child task.}

TYPE
  task_proc = PROCEDURE (VAR param);


{See the IMPLEMENTATION section for descriptions of these procedures and
functions.}

PROCEDURE create_task
  (
  task      : task_proc;
  VAR param ;
  stack_size: Word;
  VAR id    : Word;
  VAR result: Word
  );
PROCEDURE terminate_task (id: Word; VAR result: Word);
PROCEDURE switch_task;
FUNCTION current_task_id: Word;
FUNCTION number_of_tasks: Word;

{The maximum number of tasks.  Modify to suit your needs.}
CONST
  max_tasks = 32;

IMPLEMENTATION



{This record contains all the information about a task, as follows:

  stack_ptr:   Saved stack segment (ss) and stack pointer (sp) registers

  stack_org:   If the stack is stored on the heap, this is the address of
               the beginning of the block of memory allocated for the stack.

  stack_bytes: Size of stack on the heap, or 0 if the stack is not on the
               heap.  If the stack is not on the heap, then this field is 0.

  bp:          Saved value of base pointer (BP) register.

  id:          The id number of the task

Note that DS (Data Segment register) is not stored.  We can get away with
this by assuming that all tasks will use the same data segment.}

TYPE
  task_rec =
    RECORD
    stack_ptr  : Pointer;
    stack_org  : Pointer;
    stack_bytes: Word;
    bp         : Word;
    id         : Word;
    END;


{The number of tasks in the system}

VAR
  ntasks: Word;


{Information for each task.}

VAR
  task_info: ARRAY [1..max_tasks] OF task_rec;


{The last task ID assigned.  If we haven't rolled the id's over, then
this allows us to assign task ID's without checking to see what id's have
been assigned.}

VAR
  last_id    : Word;
  id_rollover: Boolean;


{This is the task number of the currently executing task}

VAR
  current_task: Word;


{This is the record type of the initial contents of the stack when a task
is created.  When the task is first switched to, it will be from within
the switch_task, terminate_task, or terminate_current_task procedure.  At
the end of switch_task, BP will be popped, then a far return will be
done.  The far return will transfer to the beginning of task.  The task
can access the parameter "task_param," which is a pointer to whatever
data structure that the creator of this task wanted to pass to the new
task.  When the task finally exits, a far return to "end_task" will be
done.  The exception is the main task, which ends the program completely
if it exits.}

TYPE
  initial_stack_rec_ptr = ^initial_stack_rec;
  initial_stack_rec =
    RECORD
    bp        : Word;
    task_addr : task_proc;
    end_task  : Pointer;
    task_param: Pointer;
    END;


{Given a task ID, return the task number, or 0 if there is no task with
that ID.}

FUNCTION find_task (target_id: Word): Word;
VAR
  n: Word;
BEGIN
  n := 1;
  WHILE (n <= ntasks) AND (task_info [n].id <> target_id) DO
    Inc (n);
  IF (n > ntasks) THEN
    n := 0;
  find_task := n
END;


{Remove a task's information from the task info array, and decrement the
number of tasks.}

PROCEDURE delete_task_info (task_num: Word);
VAR
  i: Word;
BEGIN
  FOR i := task_num TO ntasks - 1 DO
    task_info [i] := task_info [i + 1];
  Dec (ntasks)
END;


{Terminate the current task.  If the current task is the only task, then
the program is halted.  If the current task's stack was allocated from
the heap, it is freed.}

PROCEDURE terminate_current_task;


{These are defined as constants to force them into the data segment.
They can't be local, because local variables are stored on the stack and
we're going to switch to a different task (and therefore to a different
stack) before we're done with these variables.}

CONST
  old_stack_org  : Pointer = NIL;
  old_stack_bytes: Word = 0;


VAR
  task_num : Word;
  new_stack: Pointer;
  new_bp   : Word;


BEGIN {terminate_current_task}

  {If we're the last task left, then exit to DOS}

  IF ntasks <= 1 THEN
    Halt;

  {Remember where the task's stack is so that we can free it up if it's
  on the heap.  We can't free it now, because we're still using it!}

  WITH task_info [current_task] DO
    BEGIN
    old_stack_org   := stack_org;
    old_stack_bytes := stack_bytes
    END;

  {Remove the task's information from the task info array}

  delete_task_info (current_task);
  IF current_task > ntasks THEN
    current_task := 1;

  {Switch to the next task.  The stack_ptr and bp are transfered into
  local variables because it's much easier to access simple variables in
  INLINE code than it is to access array variables.}

  WITH task_info [current_task] DO
    BEGIN
    new_stack := stack_ptr;
    new_bp    := bp
    END;
  INLINE
    (
    $8b/$86/>new_stack+0/     {MOV  AX,[BP].NEW_STACK+0}
    $8b/$96/>new_stack+2/     {MOV  DX,[BP].NEW_STACK+2}
    $8b/$ae/>new_bp/          {MOV  BP,[BP].NEW_BP}
    $fa/                      {CLI}
    $8e/$d2/                  {MOV  SS,DX}
    $8b/$e0/                  {MOV  SP,AX}
    $fb                       {STI}
    );

  {If the task we just got rid of had its heap on the stack, then release
  that memory back to the free pool.}

  IF old_stack_bytes > 0 THEN
    FreeMem (old_stack_org, old_stack_bytes)

END;


{Terminate a task.  If task_id is 0, then the current task is deleted.
Possible result codes are:

  0                   No error
  invalid_task_id     There is no task with that ID number}

PROCEDURE terminate_task (id: Word; VAR result: Word);


  {Delete a task.  Do not use to delete the current task!}

  PROCEDURE delete_task (task_num: Word);
  BEGIN
    WITH task_info [task_num] DO
      IF stack_bytes > 0 THEN
        FreeMem (stack_org, stack_bytes);
    delete_task_info (task_num);
    IF current_task > task_num THEN
      Dec (current_task)
  END;


VAR
  task_num: Word;

BEGIN {terminate_task}
  result := 0;
  IF id = 0 THEN
    terminate_current_task
  ELSE
    BEGIN
    task_num := find_task (id);
    IF task_num = 0 THEN
      result := invalid_task_id
    ELSE
      IF task_num = current_task THEN
        terminate_current_task
      ELSE
        delete_task (task_num)
    END
END;


{Create a new task and pass parameter "param" to it.  Stack space for the
task is allocated from the heap, and the stack is initialized so that
procedure "new_task" will be executed with parameter "param".  Result
codes are:

  0                  No error occured
  heap_full          Unable to allocate heap for the task's stack
  too_many_tasks     Maximum number of tasks are already running

If an error occurs, then id is not set.  Otherwise, id is the task id of
the newly created task.}

PROCEDURE create_task
  (
  task      : task_proc;
  VAR param ;
  stack_size: Word;
  VAR id    : Word;
  VAR result: Word
  );


{This is the task number of the task we're creating}

VAR
  task_num: Word;


  {Allocate stack space for the task.  The minimum allowable requested
  stack size is 512 bytes.  For